L’ORUCA a retenu 5 indicateurs:
fichier <- "../../DATA/data_test.Rda"
load(fichier) # dx
library(lubridate)
library(xts)
## Loading required package: zoo
##
## Attaching package: 'zoo'
##
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
library(Rpu2)
## Loading required package: xtable
## Loading required package: openintro
## Please visit openintro.org for free statistics materials
##
## Attaching package: 'openintro'
##
## The following object is masked from 'package:datasets':
##
## cars
##
## Loading required package: plotrix
source("duree_passage.R") # si console: source("Indicateurs/duree_passage.R")
n.rpu.jour <- tapply(as.Date(dx$ENTREE), day(as.Date(dx$ENTREE)), length)
# transformation en time serie
x <- seq(min(as.Date(dx$ENTREE)), max(as.Date(dx$ENTREE)), 1)
ts.het2 <- xts(n.rpu.jour, order.by = x)
colnames(ts.het2) <- "HET2"
head(ts.het2)
## HET2
## 2015-10-01 1391
## 2015-10-02 1441
## 2015-10-03 1580
## 2015-10-04 1417
## 2015-10-05 1613
## 2015-10-06 1453
plot(ts.het2)
# Répartition normale ?
summary(n.rpu.jour)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1070 1325 1373 1384 1451 1613
sd(n.rpu.jour)
## [1] 116.6402
hist(n.rpu.jour)
Graphe avec les WE: on utilise zoo car abline ne fonctionne pas avec xts ?
we <- x[wday(x) %in% c(1,7)]
plot(zoo(ts.het2))
abline(v = as.Date(we), lty = 2, col = "red")
# sélectionne les enregistrements où le MODE_SORTIE correspond à une hospitalisation
hosp <- dx[!is.na(dx$MODE_SORTIE) & dx$MODE_SORTIE %in% c("Mutation", "Transfert"), ]
# durée de passage si hospitalisation
dp <- df.duree.pas(hosp, unit = "mins", mintime = 0, maxtime = 3)
# moyenne quotidienne
mean.dp <- tapply(dp$duree , day(as.Date(dp$ENTREE)), mean)
# transformation en time serie
ts.mean.dp <- xts(mean.dp, x)
colnames(ts.mean.dp) <- "HET3"
par(mar = c(2,4,2,5))
plot(ts, ylab = "Nombre de passages")
par(new=TRUE)
plot(ts.mean.dp, xaxt="n",xlab="",ylab="", main = "", yaxt="n", lty = 2)
axis(4)
mtext("Durée moyenne de passage (mn)",side=4,line=3, col = "blue")
n.hosp.jour <- tapply(as.Date(hosp$ENTREE), day(as.Date(hosp$ENTREE)), length)
tx.hosp <- n.hosp.jour / n.rpu.jour
ts.tx.hosp <- xts(tx.hosp, x)
colnames(ts.tx.hosp) <- "HET4"
plot(ts.tx.hosp)
dp$present.a.15h <- is.present.at(dp)
# nombre moyen de patients présents à 15h tous les jours
n.p15 <- tapply(dp$present.a.15h, yday(as.Date(dp$ENTREE)), sum)
# Transformation en TS
ts.n.p15 <- xts(n.p15, x)
colnames(ts.n.p15) <- "HET5"
plot(ts.n.p15, main = "Nombre de patients présents au SU à 15 heures")
a <- cbind(ts.het2, ts.mean.dp, ts.tx.hosp, ts.n.p15)
head(a)
## HET2 HET3 HET4 HET5
## 2015-10-01 1391 276.0884 0.1552840 73
## 2015-10-02 1441 251.7166 0.1734906 77
## 2015-10-03 1580 263.7952 0.1360759 80
## 2015-10-04 1417 226.6344 0.1362032 52
## 2015-10-05 1613 285.2227 0.1487911 91
## 2015-10-06 1453 246.2511 0.1631108 80
a[1, ]
## HET2 HET3 HET4 HET5
## 2015-10-01 1391 276.0884 0.155284 73
#radial.plot(a[1, ], labels=ion.names,rp.type="p",main="Diagramme indicateurs HET", grid.unit="%",radial.lim=c(0, 5),poly.col="yellow",show.grid.labels=1)
# corrélation entre la durée moyenne de passage quotidienne et le nombre de présents à 15h
plot(mean.dp, n.p15, main = "Corrélation durée moyenne de passage quotidienne\n et le nombre de présents à 15h", col ="black", pch = 15)
cor(mean.dp, n.p15)
## [1] 0.5050714
y <- lm(mean.dp ~ n.p15)
y
##
## Call:
## lm(formula = mean.dp ~ n.p15)
##
## Coefficients:
## (Intercept) n.p15
## 195.0130 0.7528
summary(y)
##
## Call:
## lm(formula = mean.dp ~ n.p15)
##
## Residuals:
## Min 1Q Median 3Q Max
## -22.221 -8.760 -3.053 6.692 38.822
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 195.0130 16.9535 11.503 2.51e-12 ***
## n.p15 0.7528 0.2389 3.151 0.00376 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 14.22 on 29 degrees of freedom
## Multiple R-squared: 0.2551, Adjusted R-squared: 0.2294
## F-statistic: 9.931 on 1 and 29 DF, p-value: 0.003756
abline(y)
# corrélation entre la duréee moyenne de passage et le nombre total de passages
cor(mean.dp, n.rpu.jour)
## [1] 0.02616335
# corrélation entre taux hospitalisation et nombre de passages
cor(tx.hosp, n.rpu.jour)
## [1] -0.6936409
y <- lm(n.rpu.jour ~ tx.hosp)
y
##
## Call:
## lm(formula = n.rpu.jour ~ tx.hosp)
##
## Coefficients:
## (Intercept) tx.hosp
## 2144 -4719
summary(y)
##
## Call:
## lm(formula = n.rpu.jour ~ tx.hosp)
##
## Residuals:
## Min 1Q Median 3Q Max
## -160.602 -52.294 -2.761 51.225 171.601
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2143.6 147.3 14.550 7.35e-15 ***
## tx.hosp -4719.3 910.1 -5.186 1.51e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 85.45 on 29 degrees of freedom
## Multiple R-squared: 0.4811, Adjusted R-squared: 0.4632
## F-statistic: 26.89 on 1 and 29 DF, p-value: 1.514e-05
plot(tx.hosp, n.rpu.jour, col ="black", pch = 15)
abline(y)
source("../het.R")
a <- cbind(0, ts.het2, ts.mean.dp, ts.tx.hosp, ts.n.p15)
head(a)
## X0 HET2 HET3 HET4 HET5
## 2015-10-01 0 1391 276.0884 0.1552840 73
## 2015-10-02 0 1441 251.7166 0.1734906 77
## 2015-10-03 0 1580 263.7952 0.1360759 80
## 2015-10-04 0 1417 226.6344 0.1362032 52
## 2015-10-05 0 1613 285.2227 0.1487911 91
## 2015-10-06 0 1453 246.2511 0.1631108 80
a[1, ]
## X0 HET2 HET3 HET4 HET5
## 2015-10-01 0 1391 276.0884 0.155284 73
# normalisation sous forme de variable centréée et réduite. Par défaut, moyenne et sd sont calculés à partir de l'échantillon de départ.
m <- 5
a[, 1] <- m
a[, 2] <- m + (a[, 2] - mean(n.rpu.jour)) / sd(n.rpu.jour)
a[, 3] <- m + (a[, 3] - mean(mean.dp)) / sd(mean.dp)
a[, 4] <- m + (a[, 4] - mean(tx.hosp)) / sd(tx.hosp)
a[, 5] <- m + (a[, 5] - mean(n.p15)) / sd(n.p15)
# indicateurs pour le mois d'octobre 2015
for(i in 1:31){
radar.het(a[i,])
}